home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / vbmdixpl / utils.bas < prev   
BASIC Source File  |  1995-05-09  |  11KB  |  351 lines
  1. Declare Function WriteProfileString Lib "Kernel" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpString As String) As Integer
  2. Declare Function GetProfileString Lib "Kernel" (ByVal lpAppName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Integer) As Integer
  3. Declare Function GetPrivateProfileString Lib "Kernel" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Integer, ByVal lpFileName As String) As Integer
  4. Declare Function WritePrivateProfileString Lib "Kernel" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpString As String, ByVal lplFileName As String) As Integer
  5. Declare Sub WinHelp Lib "USER" (ByVal hWnd As Integer, ByVal HlpFile As String, ByVal Cmd As Integer, ByVal dwData As Any)
  6. Declare Function GetAllTags Lib "Kernel" Alias "GetPrivateProfileString" (ByVal lpApplicationName As String, ByVal lpKeyName As Long, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize%, ByVal lpFileName$) As Integer
  7. Declare Function GetWindowsDirectory Lib "Kernel" (ByVal lpBuffer As String, ByVal nSize As Integer) As Integer
  8.  
  9.  
  10. Declare Function TrackPopupMenu% Lib "user" (ByVal hMenu%, ByVal wFlags%, ByVal X%, ByVal Y%, ByVal r2%, ByVal hWnd%, ByVal r1&)
  11. Declare Function GetMenu% Lib "user" (ByVal hWnd%)
  12. Declare Function GetSubMenu% Lib "user" (ByVal hMenu%, ByVal nPos%)
  13.  
  14.  
  15. Sub Action (Message$)
  16. ' writes a text in the statusline
  17.   MDIForm1.StatusLine.Caption = Message
  18. End Sub
  19.  
  20.  
  21.  
  22. '   ======================================================
  23. '   Centers the passed form just above center on the screen
  24. '   ======================================================
  25. Sub CenterForm (X As Form)
  26.  '   Screen.MousePointer = 11
  27.     X.Top = (Screen.Height * .85) / 2 - X.Height / 2
  28.     X.Left = Screen.Width / 2 - X.Width / 2
  29.  '   Screen.MousePointer = 0
  30. End Sub
  31.  
  32. Sub CopyFile (source$, Dest$)
  33.  
  34. Dim TheBuffer As String
  35. Const BuffLen = 16384
  36.  
  37.     On Error GoTo errhandler
  38.  
  39.  
  40.     Open source$ For Binary Access Read As #1
  41.     Open Dest$ For Binary Access Write As #2
  42.  
  43.  
  44.     If LOF(1) < BuffLen Then
  45.        TheBuffer = Space$(LOF(1))
  46.     Else
  47.        TheBuffer = Space$(BuffLen)
  48.     End If
  49.     'MsgBox (Str$(Seek(1)) + " " + Str$(LOF(1)))
  50.  
  51.     Do While Seek(1) < LOF(1)
  52.  
  53.     'MsgBox (Str$(Seek(1)) + " " + Str$(LOF(1)))
  54.     
  55.     If LOF(1) - Seek(1) < BuffLen Then
  56.        TheBuffer = Space$(LOF(1) - Seek(1) + 1)
  57.        Get #1, , TheBuffer
  58.        Put #2, , TheBuffer   ' Write to file.
  59.        Exit Do
  60.     Else
  61.        Get #1, , TheBuffer
  62.        Put #2, , TheBuffer   ' Write to file.
  63.     End If
  64.     
  65.     'Call UpdateStatus(Len(TheBuffer), FALSE)
  66.  
  67.     i% = DoEvents()
  68.     Loop
  69.  
  70.     Close #1
  71.     Close #2
  72.     Exit Sub
  73. errhandler:
  74.     warning ("problem with copying file" + source$)
  75.     Close #1
  76.     Close #2
  77.     Exit Sub
  78. End Sub
  79.  
  80. Sub critical (TheStr$)
  81. i% = MsgBox(TheStr, 16 + 4096, app.Title)
  82. End Sub
  83.  
  84. Function doit (TheStr$) As Integer
  85. ' default is YES
  86.   i% = MsgBox(TheStr, 4 + 32, app.Title)
  87.   If i% = 6 Then
  88.     doit = True
  89.   Else
  90.     doit = False
  91.   End If
  92. End Function
  93.  
  94. '   ======================================================
  95. '   Get the size of the file
  96. '   ======================================================
  97. Function GetFileSize& (source$, ExitProg%)
  98.     ExitProg% = False
  99.     On Error GoTo SizeError
  100.     X% = FreeFile
  101.     Open source$ For Binary Access Read As X%
  102.     GetFileSize& = LOF(X%)
  103.     Close X%
  104.  
  105. TheEnd:
  106.     On Error GoTo 0
  107.     Exit Function
  108.  
  109. '   ====================================================
  110. SizeError:
  111.     Msg$ = "Error getting the size of the file "
  112.     Msg$ = Msg$ + UCase$(source$) + ".  Cannot "
  113.     Msg$ = Msg$ + "continue the installation."
  114.     MsgBox Msg$, 48, "INSTALLATION ERROR"
  115.     ExitProg% = True
  116.     Resume TheEnd
  117.  
  118. End Function
  119.  
  120. Sub Information (TheStr$)
  121.  i% = MsgBox(TheStr, 64, app.Title)
  122. End Sub
  123.  
  124. Function IsValidPath% (ByVal DestPath$, ByVal DefaultDrive$)
  125.  
  126.  
  127. '   ======================================================
  128. '   Remove left and right spaces
  129. '   ======================================================
  130. '    DestPath$ = AllTrim$(DestPath$)
  131. '    DefaultDrive$ = AllTrim$(DefaultDrive$)
  132.  
  133. '   ======================================================
  134. '   Check Default Drive Parameter
  135. '   ======================================================
  136.     If Right$(DefaultDrive$, 1) <> ":" Or Len(DefaultDrive$) <> 2 Then
  137.     Msg$ = "Bad default drive parameter specified in IsValidPath "
  138.     Msg$ = Msg$ + "Function.  You passed,  """ + DefaultDrive$ + """.  Must "
  139.     Msg$ = Msg$ + "be one drive letter and "":"".  For "
  140.     Msg$ = Msg$ + "example, ""C:"", ""D:""..."
  141.     MsgBox Msg$, 64, "Setup Kit Error"
  142.     GoTo parseErr
  143.     End If
  144.  
  145.  
  146. '   ======================================================
  147. '   Insert default drive if path begins with root backslash
  148. '   ======================================================
  149.     If Left$(DestPath$, 1) = "\" Then
  150.     DestPath$ = DefaultDrive + DestPath$
  151.     End If
  152.  
  153.  
  154. '   ======================================================
  155. '   check for invalid characters
  156. '   ======================================================
  157.     On Error Resume Next
  158.     tmp$ = Dir$(DestPath$)
  159.     If Err <> 0 Then
  160.     GoTo parseErr
  161.     End If
  162.  
  163.  
  164. '   ======================================================
  165. '   Check for wildcard characters and spaces
  166. '   ======================================================
  167.     If (InStr(DestPath$, "*") <> 0) GoTo parseErr
  168.     If (InStr(DestPath$, "?") <> 0) GoTo parseErr
  169.     If (InStr(DestPath$, " ") <> 0) GoTo parseErr
  170.  
  171.  
  172. '   ======================================================
  173. '   Make Sure colon is in second char position
  174. '   ======================================================
  175.     If Mid$(DestPath$, 2, 1) <> Chr$(58) Then GoTo parseErr
  176.  
  177.  
  178. '   ======================================================
  179. '   Insert root backslash if needed
  180. '   ======================================================
  181.     If Len(DestPath$) > 2 Then
  182.       If Right$(Left$(DestPath$, 3), 1) <> "\" Then
  183.     DestPath$ = Left$(DestPath$, 2) + "\" + Right$(DestPath$, Len(DestPath$) - 2)
  184.       End If
  185.     End If
  186.  
  187.  
  188. '   ======================================================
  189. '   Check drive to install on
  190. '   ======================================================
  191.     Drive$ = Left$(DestPath$, 1)
  192.     ChDrive (Drive$)                        ' Try to change to the dest drive
  193.     If Err <> 0 Then GoTo parseErr
  194.  
  195. '   ======================================================
  196. '   Add final \
  197. '   ======================================================
  198.     If Right$(DestPath$, 1) <> "\" Then
  199.     DestPath$ = DestPath$ + "\"
  200.     End If
  201.  
  202.  
  203. '   ======================================================
  204. '   Root dir is a valid dir
  205. '   ======================================================
  206.     If Len(DestPath$) = 3 Then
  207.     If Right$(DestPath$, 2) = ":\" Then
  208.         GoTo ParseOK
  209.     End If
  210.     End If
  211.  
  212.  
  213. '   ======================================================
  214. '   Check for repeated Slash
  215. '   ======================================================
  216.     If InStr(DestPath$, "\\") <> 0 Then GoTo parseErr
  217.  
  218.  
  219. '   ======================================================
  220. '   Check for illegal directory names
  221. '   ======================================================
  222.     legalChar$ = "!#$%&'()-0123456789@ABCDEFGHIJKLMNOPQRSTUVWXYZ^_`{}~."
  223.     BackPos = 3
  224.     forePos = InStr(4, DestPath$, "\")
  225.     Do
  226.     Temp$ = Mid$(DestPath$, BackPos + 1, forePos - BackPos - 1)
  227.  
  228.     '----------------------------
  229.     'Test for illegal characters
  230.     '----------------------------
  231.     For i = 1 To Len(Temp$)
  232.         If InStr(legalChar$, UCase$(Mid$(Temp$, i, 1))) = 0 Then GoTo parseErr
  233.     Next i
  234.  
  235.     '-------------------------------------------
  236.     'Check combinations of periods and lengths
  237.     '-------------------------------------------
  238.     periodPos = InStr(Temp$, ".")
  239.     length = Len(Temp$)
  240.     If periodPos = 0 Then
  241.         If length > 8 Then GoTo parseErr                         'Base too long
  242.     Else